Monster Media 1996 #15/Monster Media Number 15 (Monster Media)(July 1996).ISO/netmail/rnr214.zip/RNRPROC.PAS

Pascal/Delphi Source File | 1996-02-04 | 36KB | 1,492 lines

unit rnrproc;

{

rnrproc.pas - rnr procedures

}

{$I rnr-def.pas}

interface

uses dos,crt,genericf,rnrglob,rnrconf,rnrfunc,rnrio,rnrfile,
 rnrmous,rnrtime,exec;

var
  execresult: integer;
  execexitcode: integer;

procedure shutdown(exitcode: integer);
procedure msgshutdown(msg: string; exitcode: integer);
procedure warn(warning: string);
procedure warn2(w1,w2: string);
procedure warn3(w1,w2,w3: string);
procedure warnerr(prg: string; doserr: integer);
procedure execp(cmd,cmdline: string);
procedure shellout;
procedure unfoldergroup(var group: string);
procedure pickasource(var trysource: string; var trysourcekind: sourcetype);
procedure updatejoin(highestnum: articlefilenametype);
procedure updatejoinunsubscribe;
procedure updatejoinsubscribe(newgroup: string;
 beforegroup: string; aftergroup: string);
procedure addnewmailgroup(newgroup: string);
procedure execviacomspec(cmdline: string);
procedure notquiets(s: string);
procedure notquietlns(s: string);
procedure notquietlnss(s1,s2: string);
procedure addalias(fromheader: string);
procedure maybemkhier(dn: string);
procedure appendencodedfile(destinationfn: string; includedfile: string);
procedure waitnseconds(n: integer);
procedure showaliases(asubstring: string);
procedure showversion;
procedure usershow(showline: string);
procedure getexistingfilename(var afn: string; prompt: string; lastfn: string);
procedure getfilename(var afn: string; prompt: string; lastfn: string);

implementation

procedure addtojoinedgroups(onegroup: string);

begin
  if numjoined<maxjoined then
    begin
      inc(numjoined);
      joinedgroups[numjoined] := onegroup;
    end;
end;

procedure shutdown;

begin
  if joinfn<>'' then
    close(joinf);
  if haskillfile then
    close(killf);
  if hasantikillfile then
    close(antikillf);

  mouseshutdown;

  xgotoxy(1,lpp);
  xwriteln;

  if console then
    begin
      textattr := oldtextattr;
      xwriteln;  {so it uses these new (original) colors for sure}
    end;

  if quitmessage<>'' then
    xwritelns(quitmessage);

  halt(exitcode);
end;

procedure msgshutdown;

begin
  quitmessage := msg;
  shutdown(exitcode);
end;

procedure warn;

var
  wastec: char;

begin
  xclreolxy(1,lpp);
  xwritess(copy(warning,1,60),' - press any key ');
  wastec := xreadkey;
  xclreolxy(1,lpp);
end;

procedure warn2;

begin
  xwriteln;
  xwriteln;
  xclreolxy(1,lpp-2);
  xclreolxy(1,lpp-1);
  xwrites(w1);
  warn(w2);
  xclreolxy(1,lpp-2);
  xclreolxy(1,lpp-1);
end;

procedure warn3;

begin
  xwriteln;
  xwriteln;
  xwriteln;
  xclreolxy(1,lpp-3);
  xclreolxy(1,lpp-2);
  xwrites(w1);
  xclreolxy(1,lpp-1);
  xwrites(w2);
  warn(w3);
  xclreolxy(1,lpp-2);
  xclreolxy(1,lpp-1);
end;

procedure warnerr;

var
  errstr: string;

begin
  errstr := 'unknown #'+itoa(doserr);

  if doserr=2 then errstr := '2 (file not found)'
  else if doserr=3 then errstr := '3 (path not found)'
  else if doserr=5 then errstr := '5 (access denied)'
  else if doserr=6 then errstr := '6 (invalid handle)'
  else if doserr=8 then errstr := '8 (not enough memory)'
  else if doserr=10 then errstr := '10 (invalid environment)'
  else if doserr=11 then errstr := '11 (invalid format)'
  else if doserr=18 then errstr := '18 (no more files)';

  warn('warning: '+prg+' failed (error '+errstr+')');
end;

procedure execp;

var
  path: string;
  foundapath: boolean;
  execed: boolean;
  ncmd: string;
  nbase: string;
  npath: string;
  el: string;
  at: integer;

    function indir(cmd,dir: string): boolean;

    var
      fileinfo: searchrec;

    begin {indir}
      findfirst(withbackslash(dir)+cmd,archive,fileinfo);
      indir := (doserror=0);
    end; {indir}

    procedure execswappable(pgm, cmdline: string);

    begin {execswappable}
      if showdebug('exec') then
        begin
          xwriteln;
          xwritesss('running:  pgm="',pgm,'", cmdline="');
          xwritelnss(cmdline,'"');
          xwriteln;
        end;

{
          $0000..00FF: The EXECed Program's return code
          $0100:       Error writing swap file
          $0200:       Program file not found
          $03xx:       DOS-error-code xx calling EXEC
          $0400:       Error allocating environment buffer
}

      if swap='' then
        execresult := do_exec(pgm, cmdline, 1, $ffff, false)
      else if swap='ems' then
        execresult := do_exec(pgm, cmdline, 1, $ffff, false)
      else if swap='disk' then
        execresult := do_exec(pgm, cmdline, -1, $ffff, false)
      else if swap='no' then
        begin
          dos.exec(pgm, cmdline);
          execresult := doserror;
          if execresult=0 then
            execresult := dosexitcode
          else
            execresult := $300+execresult;
        end
      else
        begin
          xwritelns('unknown swap parameter "'+swap+'", so not swapping');
          dos.exec(pgm, cmdline);
          execresult := doserror;
          if execresult=0 then
            execresult := dosexitcode
          else
            execresult := $300+execresult;
        end;

      if showdebug('exec') then
        begin
          xwriteln;
          xwritelnssss('back from:  ',pgm,' ',cmdline);
          xwritelnsi('execresult=',execresult);
        end;

      execexitcode := 0;
      if (execresult and $ff00)=0 then
        execexitcode := (execresult and $00ff);

{ if there was no error running, return 0 }
{ if there was en error running, report it }
{ otherwise, just leave the error as is (256, 512, 1024 stick out) }

      if (execresult and $ff00)=0 then
        execresult := 0
      else if (execresult and $ff00)=3 then
        execresult := (execresult and $00ff);


    end; {execswappable}

begin
  foundapath := false;
  execed := false;

  ncmd := unslash(cmd);
  nbase := ncmd;

{strip path from nbase}

  repeat
    at := pos(':',nbase);
    if at<>0 then
      nbase := copy(nbase,at+1,255);
  until at=0;

  repeat
    at := pos('\',nbase);
    if at<>0 then
      nbase := copy(nbase,at+1,255);
  until at=0;

{chop off path.  if trailing \, chop, unless root or drive:root (then add .)}

  npath := '';
  if nbase<>ncmd then
    begin
      foundapath := true;  {so as to not look further than given path}
      npath := copy(ncmd,1,length(ncmd)-length(nbase));

      if npath='\' then
        npath := npath+'.';

      if right(npath,1)=':' then
        npath := npath+'.';

      if pos(':\',npath)<>0 then
        if copy(npath,length(npath)-1,2)=':\' then
          npath := npath+'.';

      if copy(npath,length(npath),1)='\' then
        npath := copy(npath,1,length(npath)-1);
    end;

{if an explicit path, use it -- otherwise, just try '.'}

  if npath='' then
    npath := '.';

{if no extension, try com then exe}

  if pos('.',nbase)=0 then
    begin
      if showdebug('exec') then
        xwritelnssss('looking for ',nbase,'.com/.exe in ',npath);

      if indir(nbase+'.com',npath) then
        begin
          foundapath := true;
          execed := true;
          execswappable(withbackslash(npath)+nbase+'.com',cmdline);
        end
      else if indir(nbase+'.exe',npath) then
        begin
          foundapath := true;
          execed := true;
          execswappable(withbackslash(npath)+nbase+'.exe',cmdline);
        end;
    end
  else if indir(nbase,npath) then
    begin
      foundapath := true;
      execed := true;
      execswappable(withbackslash(npath)+nbase,cmdline);
    end;

  if not foundapath then
    begin

{not found in explicit path (or ., if no explicit path).  try $PATH}

      path := getenv('PATH');
      while not foundapath and (path<>'') do
        begin
          if copy(path,length(path),255)<>';' then
            path := path+';';

          at := pos(';',path);
          el := copy(path,1,at-1);
          path := copy(path,at+1,255);

          if pos('.',nbase)=0 then
            begin
              if showdebug('exec') then
                xwritelnssss('looking for ',nbase,'.com/.exe in ',el);

              if indir(nbase+'.com',el) then
                begin
                  foundapath := true;
                  execed := true;
                  execswappable(withbackslash(el)+nbase+'.com',cmdline);
                end
              else if indir(nbase+'.exe',el) then
                begin
                  foundapath := true;
                  execed := true;
                  execswappable(withbackslash(el)+nbase+'.exe',cmdline);
                end;
            end
          else
            begin
              if showdebug('exec') then
                xwritelnssss('looking for ',nbase,' in ',el);

              if indir(nbase,el) then
                begin
                  foundapath := true;
                  execed := true;
                  execswappable(withbackslash(el)+nbase,cmdline);
                end;
            end;
        end;
    end;

  if not execed then
    begin
      warn('could not exec '+cmd+' -- does it exist?');
    end;

{$ifdef timeout}
  resetidle;
{$endif}

end;

procedure shellout;

var
  wastec: char;

begin
  if console and trusted then
    begin
      xgotoxy(1,lpp);
      xwriteln;
      xwriteln;
      xwriteln;
      xwritelns('use `EXIT'' to return to rnr');

{it is now impossible to not swap, but this wasn't always true}
      if swap='' then
        xwritelns('be careful - you do not have much memory available')
      else
        xwritelns(
         'swapped -- you should have most memory available');

      xwriteln;
      if comspec='' then
        begin
          warn('could not find what shell to run - no COMSPEC variable');
        end
      else
        begin
          mouseshutdown;
          execp(comspec,'');
          mouseinit;

          xgotoxy(1,lpp);
          xwriteln;
          xwriteln;
          xwriteln;

          if execresult<>0 then
            xwrites('(error) press any key to return to '+newsreadername+' ')
          else
            xwrites('press any key to return to '+newsreadername+' ');
          wastec := xreadkey;

          xwrites(^M);
          xclreol;

          if execresult<>0 then
            warnerr('shell',execresult);
        end
    end;
end;

procedure unfoldergroup;

begin
  if length(group)>0 then
    if group[1]='=' then
      begin
        if length(group)=1 then
          group := mailprefix
        else
          group := mailprefix+'.'+copy(group,2,255);

{ prevent possible security hole }

        if (numoccur('\',unslash(group))<>0) or
         (numoccur(':',group)<>0) or
         (pos('..',group)<>0) then
          group := mailprefix;
      end;
end;

procedure pickasource;

const
  baseprompt =
{note:  line beyond 80 columns, only due to highlighting toggle chars}
'{j}ump;{a}ll;{1}-{9} pgs;{#};{f}aq;{h}eader/{b}ody/{w}hole;{d}ate;{s}ubj/{n}ame/{e}ither;{+};{-}';

var
  shouldsubscribe: char;
  wheretoadd: char;
  neargroup: string;
  neargroupsourcekind: sourcetype;

  prompt: string;
  howto: char;

  tempdate: string;

begin
  xclreolxy(1,lpp);

  if trysource='' then
    begin
      xwrites('Goto group, group initials, or directory: ');
      trysource := currsource;

{ changed yespreserve to no - it was a pain having to hit ^U to cancel this }

      xreadlnse(trysource,cols-30,nopreserve,endkeyswithspace);

{mail folder support}

      unfoldergroup(trysource);
    end;

  if trysource='' then
    xclreolxy(1,lpp)
  else
    if not expandsource(trysource,trysourcekind) then
      begin
        if getgroupdir(trysource)='' then
          begin
            warn('could not find a group or directory to match');
            trysource := '';
          end
        else
          begin
            wheretoadd := 'o';
            neargroup := '';

            if not quiet then
              begin
                xclreolxy(1,lpp-4);
                xclreolxy(1,lpp-3);
                xwrites('to "subscribe" is to add a group to your join file');
                xclreolxy(1,lpp-2);
                xwrites('which means it will be presented to you each time');
                xclreolxy(1,lpp-1);
                xwrites('you read news');
              end;

            shouldsubscribe := onekeydef('subscribe?  {y}/{n}','yn','y');
            xwrites(shouldsubscribe);

            if shouldsubscribe='n' then
              trysource := '';

            if trysource<>'' then
              begin
                wheretoadd := onekeydef(
          '{^}beginning, {$}end, {-}before or {+}after some group, {o}ops',
                 '^$-+o','$');
                xwrites(wheretoadd);
                if wheretoadd='o' then
                  trysource := '';
              end;

            if trysource<>'' then
              begin
                if (wheretoadd='-') or (wheretoadd='+') then
                  begin
                    xclreolxy(1,lpp);
                    if wheretoadd='-' then
                      xwrites('before what group?  ')
                    else
                      xwrites('after what group?  ');

                    if currsourcekind=sourcegroup then
                      neargroup := currsource;

                    xreadlnse(neargroup,cols-25,yespreserve,endkeyswithspace);
                    if neargroup='' then
                      trysource := ''
                    else
                      if not expandsource(neargroup,neargroupsourcekind) then
                        begin
                          warn('not joined to '+neargroup+
                           ' either -- using beginning');
                          wheretoadd := '^';
                        end
                      else if neargroupsourcekind<>sourcegroup then
                        begin
                          warn('not joined to '+neargroup+
                           ' either -- using beginning');
                          wheretoadd := '^';
                        end;
                  end;
              end;

{
due to special-casing in updatejoinsubscribe, could
combine ^ with - and $ with +, but I hope this is more clear
}

            if trysource<>'' then
              begin
                xclreolxy(1,lpp);
                if wheretoadd='^' then
                  updatejoinsubscribe(trysource,'','.not-at-end.')
                else if wheretoadd='$' then
                  updatejoinsubscribe(trysource,'.not-at-begin.','')
                else if wheretoadd='-' then
                  updatejoinsubscribe(trysource,neargroup,'.not-at-end.')
                else
                  updatejoinsubscribe(trysource,'.not-at-begin',neargroup);

                if not expandsource(trysource,trysourcekind) then
                  begin
                    warn('unable to add group!');
                    trysource := '';
                  end;
              end;
          end;
      end;

  if trysource<>'' then
    begin
      xclreolxy(1,lpp-1);
      xwritelnss('found source: ',trysource);

      if not quiet then
        begin
          xclreolxy(1,lpp-11);

          xclreolxy(1,lpp-10);
        xwrites(sourcedesc(trysource,trysourcekind));

          xclreolxy(1,lpp-9);

          xclreolxy(1,lpp-8);
        xwritehighlights(
        '{j}ump to last position; {a}ll articles; {#} pick start article');

          xclreolxy(1,lpp-7);
        xwritehighlights(
        '{f}requently asked questions;'+
        ' {h}eader,{b}ody,{w}hole-article searching');

          xclreolxy(1,lpp-6);
        xwritehighlights(
        '{+} no filtering due to `s''een, `k''ill, etc.; {d}ate range');

          xclreolxy(1,lpp-5);
        xwritehighlights(
        '{s}ubject, {n}ame, {e}ither (like {h}eaders, but faster)');

          xclreolxy(1,lpp-4);
        xwritehighlights(
        '{-} show antikilled only');

          xclreolxy(1,lpp-3);
        xwritehighlights(
        'remember, you can just hit {space} to start scanning normally');

          xclreolxy(1,lpp-2);
        end;

      repeat

        prompt := '';

        if readunfiltered then
          prompt := prompt+'+';

        if antikilledonly then
          prompt := prompt+'-';

        if searchinheaders and searchinbody then
          prompt := prompt+'w'
        else if searchinheaders then
          prompt := prompt+'h'
        else if searchinbody then
          prompt := prompt+'b';

        if searchthedate then
          prompt := prompt+'d';

        if searchinsubj and searchinname then
          prompt := prompt+'e'
        else if searchinsubj then
          prompt := prompt+'s'
        else if searchinname then
          prompt := prompt+'n';

        if prompt='' then
          prompt := baseprompt
        else
          prompt := baseprompt+' '+prompt;

        howto := onekeydef(prompt,'ja123456789#hbw+-fdsne','j');

        if howto='+' then
          readunfiltered := not readunfiltered;
        if howto='-' then
          antikilledonly := not antikilledonly;
        if howto='h' then
          searchinheaders := not searchinheaders;
        if howto='b' then
          searchinbody := not searchinbody;

        if howto='w' then  {I think this is the best way to toggle this}
          begin
            searchinheaders := not (searchinheaders or searchinbody);
            searchinbody := searchinheaders;
          end;

        if howto='d' then
          searchthedate := not searchthedate;

        if howto='s' then
          searchinsubj := not searchinsubj;
        if howto='n' then
          searchinname := not searchinname;
        if howto='e' then
          begin
            searchinsubj := not (searchinsubj or searchinname);
            searchinname := searchinsubj;
          end;

        if searchinsubj or searchinname then
          begin
            searchinheaders := false;
            searchinbody := false;
          end;

      until (howto<>'+') and
       (howto<>'-') and
       (howto<>'w') and
       (howto<>'h') and
       (howto<>'b') and
       (howto<>'d') and
       (howto<>'n') and
       (howto<>'s') and
       (howto<>'e');

{ setting it to impossiblylarge will automatically set it to current later }
      lowestartsearched := impossiblylargeart;
      readpagesback := 0;

{ only groups are in the join file }
      if trysourcekind<>sourcegroup then
        lowestartsearched := 0;

      if howto='#' then
        begin
          xclreolxy(1,lpp);
          xwrites('Start at article number (blank to ignore) ');
          xreadlnse(prompt,cols-30,nopreserve,endkeyswithspace);
          if prompt<>'' then
            begin
              lowestartsearched := atol(prompt);

{ we really only search filenames numerically _above_ lowestartsearched }
              if lowestartsearched<>0 then
                dec(lowestartsearched);

            end;
        end;

{ for `f' (FAQs), the searching is done for us with a cookie -- don't prompt }
      if howto<>'f' then
        if searchinheaders or
         searchinbody or
         searchinsubj or
         searchinname then
          begin
            xclreolxy(1,lpp);
            xwrites('Search for: ');
            xreadlns(searchtext,cols-30,yespreserve);
            if searchtext='' then
              searchtext := newsreadername;
          end;

      if howto='f' then  {now reset them to what we want}
        begin
          searchinheaders := true;
          searchinbody := false;
          searchinsubj := false;
          searchinname := false;

          searchtext := faqcookie;
          readunfiltered := true;
          antikilledonly := false;
          lowestartsearched := 0;
        end;

      if searchthedate then
        begin
          if not quiet then
            begin
          xclreolxy(1,lpp-5);

          xclreolxy(1,lpp-4);
        xwritehighlights(
        'if you want no lower bound, use 1900-01-01');

          xclreolxy(1,lpp-3);
        xwritehighlights(
        'if you want no upper bound, use 2020-01-01 or something similar');

          xclreolxy(1,lpp-2);
        end;

          xclreolxy(1,lpp);
          xwrites('Date YYYY-MM-DD: earliest: ');

          tempdate := datetostring(searchdatelow);
          xreadlns(tempdate,cols-30,yespreserve);
          if tempdate='' then
            tempdate := currentdatestring;
          searchdatelow := ymdtodate(tempdate);

          xclreolxy(1,lpp);
          xwrites('Date YYYY-MM-DD: latest: ');

          tempdate := datetostring(searchdatehigh);
          xreadlns(tempdate,cols-30,yespreserve);
          if tempdate='' then
            tempdate := currentdatestring;
          searchdatehigh := ymdtodate(tempdate);
        end;

      if howto='a' then
        lowestartsearched := 0;

{ no join file for anything but groups }
      if trysourcekind=sourcegroup then
        if (howto>='1') and (howto<='9') then
          readpagesback := ord(howto)-ord('0');

      xclreolxy(1,lpp);
    end;
end;

procedure updatejoin;

var
  oldcurrsource: string;
  groupline: string;
  tempf: text;

begin
  if currsourcekind=sourcegroup then
    begin
      oldcurrsource := currsource;

      if highestnum>alreadyread then
        begin
          if quiet then
            xwritelns('Updating join file...')
          else
            xwritelnsss('Updating join file for ',currsource,'...');

          assign(tempf,withbackslash(temporarydir)+userid);
          rewrite(tempf);

          reset(joinf);
          while not eof(joinf) do
            begin
              readln(joinf,groupline);
              if getfirstw(groupline)=currsource then
                writeln(tempf,currsource,' ',highestnum)
              else
                writeln(tempf,groupline);
            end;

          close(joinf);
          close(tempf);

          reset(tempf);
          rewrite(joinf);
          while not eof(tempf) do
            begin
              readln(tempf,groupline);
              writeln(joinf,groupline);
            end;
          close(tempf);
          close(joinf);

          erase(tempf);

          reset(joinf);
        end;

      currsource := oldcurrsource;
    end;
end;

procedure updatejoinunsubscribe;

var
  groupline: string;
  onegroup: string;
  tempf: text;

begin
  xwritelns('Updating join file...');

  assign(tempf,withbackslash(temporarydir)+userid);
  rewrite(tempf);

  numjoined := 0;

  reset(joinf);
  while not eof(joinf) do
    begin
      readln(joinf,groupline);
      onegroup := getfirstw(groupline);
      if onegroup<>currsource then
        begin
          addtojoinedgroups(onegroup);
          writeln(tempf,groupline);
        end;
    end;

  close(joinf);
  close(tempf);

  rewrite(joinf);
  reset(tempf);
  while not eof(tempf) do
    begin
      readln(tempf,groupline);
      writeln(joinf,groupline);
    end;
  close(tempf);
  close(joinf);

  erase(tempf);

  reset(joinf);
end;

procedure updatejoinsubscribe;

var
  added: boolean;

  tempf: text;

  groupline: string;
  onegroup: string;

begin
  added := false;

  xwritelns('Updating join file...');

  assign(tempf,withbackslash(temporarydir)+userid);
  rewrite(tempf);

  numjoined := 0;

  reset(joinf);
  while not eof(joinf) do
    begin
      readln(joinf,groupline);
      onegroup := getfirstw(groupline);

      if not added then
        begin
          if (beforegroup='') and not ismailgroup(onegroup) then
            begin
              addtojoinedgroups(newgroup);
              writeln(tempf,newgroup,' 0');
              added := true;
            end
          else if beforegroup=onegroup then
            begin
              addtojoinedgroups(newgroup);
              writeln(tempf,newgroup,' 0');
              added := true;
            end;
        end;

      addtojoinedgroups(onegroup);
      writeln(tempf,groupline);

      if not added then
        begin
          if aftergroup=onegroup then
            begin
              addtojoinedgroups(newgroup);
              writeln(tempf,newgroup,' 0');
              added := true;
            end;
        end;
    end;

  if not added then
    begin
      addtojoinedgroups(newgroup);
      writeln(tempf,newgroup,' 0');
    end;

  close(joinf);
  close(tempf);

  rewrite(joinf);
  reset(tempf);
  while not eof(tempf) do
    begin
      readln(tempf,groupline);
      writeln(joinf,groupline);
    end;
  close(tempf);
  close(joinf);

  erase(tempf);

  reset(joinf);
end;

procedure addnewmailgroup;

var
  added: boolean;
  seenmailbutnotnew: boolean;
  groupline: string;
  onegroup: string;
  tempf: text;

begin
  added := false;

  seenmailbutnotnew := false;

  xwritelns('Updating join file...');

  assign(tempf,withbackslash(temporarydir)+userid);
  rewrite(tempf);

  numjoined := 0;

  reset(joinf);
  while not eof(joinf) do
    begin
      readln(joinf,groupline);
      onegroup := getfirstw(groupline);

      if onegroup=mailprefix then
        seenmailbutnotnew := true;

{insert the new group alphabetically in the mail groups, or after}
{the last one if it's the biggest alphabetically of them all}

      if (seenmailbutnotnew and not ismailgroup(onegroup)) or
       (ismailgroup(onegroup) and (onegroup>newgroup)) then
        if not added then
          begin
            added := true;

            addtojoinedgroups(newgroup);
            writeln(tempf,newgroup,' 0');

            seenmailbutnotnew := false;
          end;

      addtojoinedgroups(onegroup);
      writeln(tempf,groupline);
    end;

  if not added then
    begin
      addtojoinedgroups(newgroup);
      writeln(tempf,newgroup,' 0');
    end;

  close(joinf);
  close(tempf);

  rewrite(joinf);
  reset(tempf);

  while not eof(tempf) do
    begin
      readln(tempf,groupline);
      writeln(joinf,groupline);
    end;

  close(tempf);
  close(joinf);

  erase(tempf);

  reset(joinf);
end;

procedure execviacomspec;

{mouse shutdown already done, and init will be done soon after}

begin
  execp(comspec,'/c '+cmdline);
end;

procedure notquiets;

begin
  if not quiet then
    xwrites(s);
end;

procedure notquietlns;

begin
  if not quiet then
    xwritelns(s);
end;

procedure notquietlnss(s1,s2: string);

begin
  if not quiet then
    xwritelnss(s1,s2);
end;

procedure addalias;

{caller must refresh}

var
  aliasaddr: string;
  aliasname: string;
  aliasdest: char;
  aliasfn: string;
  aliasf: text;

begin
  xclreolxy(1,lpp);

  aliasaddr := getfromaddr(fromheader);

  xwrites('Address to add to aliases: ');
  xreadlnse(aliasaddr,50,yespreserve,endkeyswithspace);

  xclreolxy(1,lpp);

  if (aliasaddr<>'') then
    begin
      xwrites('local alias to use for that address: ');
      aliasname := lower(getfirstw(getfromname(fromheader)));
      xreadlnse(aliasname,cols-40,yespreserve,endkeyswithspace);
      xclreolxy(1,lpp);

      if aliasname<>'' then
        begin
          aliasdest := 'p';
          if trusted then
            begin
              aliasdest := onekeydef(
               '{p}ersonal or {s}ystem-wide alias, or {q}uit','psq','p');
            end
          else
            begin
              aliasdest := onekeydef(
               '{p}ersonal alias or {q}uit','pq','p');
            end;

          if not trusted then
            if aliasdest='s' then
              aliasdest := 'p';

          aliasfn := '';

          if aliasdest='p' then
            aliasfn := home+'\aliases'
          else if aliasdest='s' then
            begin
              if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
                aliasfn := configdir+'\system\'+'aliases'
              else if xiface=ifaceuupc then
                aliasfn := unslash(getconfig('aliases'));
            end;

          if aliasfn<>'' then
            begin
              assign(aliasf,aliasfn);
{$I-}
              append(aliasf);
{$I+}
              if ioresult<>0 then
{$I-}
                rewrite(aliasf);
{$I+}

              if ioresult=0 then
                begin
                  writeln(aliasf,aliasname,' ',aliasaddr);
                  close(aliasf);
                end
              else
                warn('could not create '+aliasfn);
            end;

          xclreolxy(1,lpp);

        end;
    end;
end;

procedure maybemkhier;

var
  response: char;

begin
  if not dexists(dn) then
    begin
      if not trusted then
        begin
          xwritelnss(dn,' does not exist -- it must be created first');
          shutdown(1);
        end;

      response :=
       onekeydef(dn+' does not exist - create it? {y}/{N}','yNq','y');

      if response='y' then
        mkhier(dn);

      xclreolxy(1,lpp);

      if response='q' then
        shutdown(1);
    end;
end;

procedure appendencodedfile;

var
  destinationf: text;
  encodedfn: string;
  encodebarecmd: string;
  encodeparams: string;
  encodedf: text;
  encodedline: string;

begin
  encodedfn := withbackslash(temporarydir)+userid+'.enc';

  encodeparams := encodecommand;
  encodebarecmd := chopfirstw(encodeparams);

  if encodeparams<>'' then
    encodeparams := encodeparams+' ';

  encodeparams := encodeparams+includedfile+' '+encodedfn;

  xwriteln;
  xwritelns('encoding...');

  execp(encodebarecmd,encodeparams);
{}{}{}{} {check execresult!}

  assign(destinationf,destinationfn);
  append(destinationf);

  safereset(encodedf,encodedfn);
  if fileresult<>0 then
    writeln(destinationf,'encode failed for '+includedfile)
  else
    begin
      xwritelns('reading...');

      while not eof(encodedf) do
        begin
          readln(encodedf,encodedline);
          writeln(destinationf,encodedline);
        end;
      close(encodedf);
    end;

  close(destinationf);
end;

{ assumes n<320 or so}
procedure waitnseconds;

var
  h,m,s,s00: word;
  olds, olds00: word;
  starting: word;
  s00towait: integer;

begin
  if n<320 then
    s00towait := n*100
  else
    s00towait := 32000;

  gettime(h,m,olds,olds00);
  s := olds;
  s00 := olds00;

  starting := olds*100+olds00;

  while (s*100+s00)<starting+s00towait do
    begin
      gettime(h,m,s,s00);
      if s<olds then
        dec(starting,6000);  {safer than inc(s,60) to allow for n>59}
    end;
end;

procedure showaliases(asubstring: string);

var
  aliasfn: string;
  currentline: integer;
  foundany: boolean;

  function showedaliasesin(aliasfn: string; asubstring: string): boolean;

  var
    result: boolean;
    aliasf: text;
    done: boolean;
    oneline: string;
    upsubstring: string;

  begin {showedaliasesin}
    result := false;
    upsubstring := upper(asubstring);

    safereset(aliasf,aliasfn);
    if fileresult=0 then
      begin
        done := false;
        while not done and not eof(aliasf) do
          begin
            readln(aliasf,oneline);
            if trim(oneline)<>'' then
              if (asubstring='') or textintext(upsubstring,upper(oneline)) then
                begin
                  result := true;
                  xgotoxy(1,currentline);
                  xwrites(oneline);

                  inc(currentline);
                  if currentline>lpp-2 then
                    begin
                      done := true;

                      xclreolxy(1,currentline+1);
                      xclreolxy(1,currentline);
                      xwrites('(stopped at one screen)');
                    end;
                end;
          end;
        close(aliasf);
      end;

    showedaliasesin := result;
  end; {showedaliasesin}

begin
  currentline := 2;
  foundany := false;

  xclrscr;

  if (xiface=ifacewaffle) or (xiface=ifaceuufree) then
    aliasfn := configdir+'\system\'+'aliases'
  else if xiface=ifaceuupc then
    aliasfn := unslash(getconfig('aliases'));

  if aliasfn<>'' then
    foundany := showedaliasesin(aliasfn,asubstring);

  if aliasfn<>home+'\aliases' then
    begin
      aliasfn := home+'\aliases';
      foundany := foundany or showedaliasesin(aliasfn,asubstring);
    end;

  if foundany then
    warn('done')
  else
    if asubstring='' then
      warn('no aliases')
    else
      warn('no aliases matched '+asubstring);
end;

procedure showversion;

begin
  warn2('',newsreadername+' '+newsreaderversion+', released '+releasedate);
end;

procedure usershow;

var
  mangledshowline: string;
  whattoshow: string;
  showparameters: string;

begin
  mangledshowline := ltrim(trim(showline));
  if mangledshowline='' then
    begin
      warn('show aliases [optional-substring], show time, show version');
    end
  else
    begin
      whattoshow := chopfirstw(mangledshowline);
      showparameters := mangledshowline;
      if partialmatch(whattoshow,'aliases','a') then
        begin
          showaliases(showparameters);
        end
      else if partialmatch(whattoshow,'time','t') then {remove this later}
        begin
          warn('it is now '+currentdatestring+' '+currenttimestring);
        end
      else if partialmatch(whattoshow,'version','v') then
        begin
          showversion;
        end
      else
        begin
          warn('unknown show object: '+whattoshow);
        end;
    end;
end;

procedure getexistingfilename;

var
  resultfn: string;
  resultf: text;
  findexistingfileparams: string;
  findexistingfilebarecmd: string;

begin
  if findexistingfilecommand=builtincookie then
    begin
      xclreolxy(1,lpp);
      xwritess(prompt,' ');
      afn := lastfn;
      xreadlnse(afn,cols-5-length(prompt),yespreserve,endkeyswithspace);
    end
  else
    begin
      resultfn := withbackslash(temporarydir)+userid+'.fil';

      findexistingfileparams := findexistingfilecommand;
      findexistingfilebarecmd := chopfirstw(findexistingfileparams);

      if findexistingfileparams<>'' then
        findexistingfileparams := findexistingfileparams+' ';

      findexistingfileparams := findexistingfileparams+resultfn;

      execp(findexistingfilebarecmd,findexistingfileparams);
{}{}{}{} {check execresult!}

      safereset(resultf,resultfn);
      if fileresult<>0 then
        warn('could not read '+resultfn)
      else
        begin
          if eof(resultf) then
            afn := ''
          else
            readln(resultf,afn);

          close(resultf);
        end;
    end;
end;

procedure getfilename;

var
  resultfn: string;
  resultf: text;
  findfileparams: string;
  findfilebarecmd: string;

begin
  if findfilecommand=builtincookie then
    begin
      xclreolxy(1,lpp);
      xwritess(prompt,' ');
      afn := lastfn;
      xreadlnse(afn,cols-5-length(prompt),yespreserve,endkeyswithspace);
    end
  else
    begin
      resultfn := withbackslash(temporarydir)+userid+'.fil';

      findfileparams := findfilecommand;
      findfilebarecmd := chopfirstw(findfileparams);

      if findfileparams<>'' then
        findfileparams := findfileparams+' ';

      findfileparams := findfileparams+resultfn;

      execp(findfilebarecmd,findfileparams);
{}{}{}{} {check execresult!}

      safereset(resultf,resultfn);
      if fileresult<>0 then
        warn('could not read '+resultfn)
      else
        begin
          if eof(resultf) then
            afn := ''
          else
            readln(resultf,afn);

          close(resultf);
        end;
    end;
end;

end.